package DR;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(sets rep6 stable check perm permlite showres filterp
						 rotP rotQ rotR rotS rotT rotU rotV rotW
						 rotp rotq rotr rots rott rotu rotv rotw
					   $showp);

use warnings;
use strict;
use 5.018;

my $s = {};
my (%res, %done);
our $showp = sub { my $n = shift; $n and $n < 78 and $n > 65; };
# 78: nothing changed

sub sets {
	for my $i (0..5) {
		for my $j (0..12) {
			$s->{$i}{$j} = "$i/$j";
		}
	}
}
sub filterp {
	my ($pres, $goal, $fix) = @_;
	my (@pr, @gl);
	my %seen;
	my $pushpr = sub {
		for my $p (@_) {
			my $key = join('/', @{$p});
			next if $seen{$key}++; # make sure there are no duplicates
			push @pr, $p;
		}
	};
	no warnings 'experimental';
	for (split /,/, $pres||'') {
		when (m%^(\d)/(\d+)%) { $pushpr->([$1, $2]) }
		when ('edges') {
			for my $i (0..5) {
				$pushpr->([$i, $_]) for 5, 6, 7, 8;
			}
		}
		when ('corners') {
			for my $i (0..5) {
				$pushpr->([$i, $_]) for 9, 10, 11, 12;
			}
		}
		when ('P') { $pushpr->([0,11], [2,12], [3,10]) }
		when ('Q') { $pushpr->([0,12], [3,9],  [4,11]) }
		when ('R') { $pushpr->([0,9],  [1,12], [4,10]) }
		when ('S') { $pushpr->([0,10], [1,11], [2,9] ) }
		when ('T') { $pushpr->([1,10], [2,10], [5,11]) }
		when ('U') { $pushpr->([1,9],  [4,9],  [5,12]) }
		when ('V') { $pushpr->([3,12], [4,12], [5,9] ) }
		when ('W') { $pushpr->([3,11], [2,11], [5,10]) }
		default    { warn "Illegal preserve key: $_\n" }
	}
	my $min = scalar @pr;
	for (split /,/, $goal||'') {
		if (m%^(\d)/(\d+):(\d/\d+)$%) {
			my ($i, $j, $val) = ($1, $2, $3);
			push @gl, [$i, $j, $val];
		} else {
			warn "Illegal goal: $_\n";
		}
	}
	return sub {
		my $n = shift;
		return 0 if $n and (($fix and $n != $fix) or ($min and $n < $min));
		for (@gl) {
			my ($i, $j, $val) = @{$_};
			return 0 unless $s->{$i}{$j} eq $val;
		}
		for (@pr) {
			my ($i, $j) = @{$_};
			return 0 unless $s->{$i}{$j} eq "$i/$j";
		}
		return 1;
	}
}
sub stable {
	my $n = 0;
	for my $i (0..5) {
		for my $j (0..12) {
			$n++ if $s->{$i}{$j} eq "$i/$j" or
				($s->{$i}{$j} =~ m%^$i/% and $j =~ /^[1-4]$/);
		}
	}
	return $n;
}
sub check {
	my %h;
	for my $i (0..5) {
		for my $j (0..12) {
			$h{$s->{$i}{$j}}++;
		}
	}
	my $n = scalar keys %h;
	die "Only $n unique values!\n" unless $n == 78;
}
sub rep {
	my ($i, $j) = @_;
	my $a = $s->{$i}{$j};
	$a =~ s%^$i/%-/%;
	return $a eq "-/$j"? '- ' : $a;
}
sub printF {
	my ($i, $j, $c) = @_;
	no warnings 'experimental';
	for ($j) {
		when(0) { printf " %6s%6s%6s$c",    map {rep($i, $_)} 10, 5, 9  }
		when(1) { printf "    %6s%6s   $c", map {rep($i, $_)}   1, 4    }
		when(2) { printf " %6s%6s%6s$c",    map {rep($i, $_)} 6, 0, 8   }
		when(3) { printf "    %6s%6s   $c", map {rep($i, $_)}   2, 3    }
		when(4) { printf " %6s%6s%6s$c",    map {rep($i, $_)} 11, 7, 12 }
	};
}
sub rep6 {
	for(0..4) { print ' 'x20; printF(1, $_, "\n") }
	for my $i (0..4) {
		printF($_, $i, ' ') for 2, 0;
		printF(4, $i, "\n");
	}
	for my $i (3, 5) {
		for (0..4) { print ' 'x20; printF($i, $_, "\n") }
	}
	say '-'x32;
}
sub tmpcpy {
	my $t = {};
	for my $i (0..5) {
		for my $j (0..12) { $t->{$i}{$j} = $s->{$i}{$j} }
	}
	return $t;
}
sub perm {
	my @seq = @_;
	my $k = join '', @seq;
	return if $done{$k}++;
	sets();
	eval "rot$_" for @seq;
	my $n = stable;
	push @{$res{$n}}, $k;
	# if (interestingly) stable, show the representation
	if ($showp->($n)) {
		say "$k: $n";
		rep6;
	}
}
sub permlite {
	my @seq = @_;
	my $k = join '', @seq;
	return if $k =~ /(.)\1/i;
	sets();
	eval "rot$_" for @seq;
	if ($showp->(0)) {
		say "$k:";
		rep6;
	}
}
sub showres { #nr of combinations per stability grade
	for my $n (sort{$a <=> $b} keys %res) {
		print "$n: ", scalar @{$res{$n}}, "\n";
	}
}
sub rotP {
	my $t = tmpcpy;
	@{$s->{0}}{0..3,6,7,10..12} = @{$t->{3}}{0,4,1,2,5,6,9..11};
	$s->{1}{11} = $t->{4}{11};
	@{$s->{2}}{0,2..4,7,8,9,11,12} = @{$t->{0}}{0..3,6,7,12,10,11};
  @{$s->{3}}{0,4,1,2,5,6,9..11} = @{$t->{2}}{0,2..4,7,8,11,12,9};
  $s->{4}{11} = $t->{5}{10};
  $s->{5}{10} = $t->{1}{11};
}
sub rotQ {
	my $t = tmpcpy;
	@{$s->{0}}{0,2..4,7..9,11,12} = @{$t->{4}}{0..3,6,7,12,10,11};
	$s->{1}{12} = $t->{5}{9};
	$s->{2}{12} = $t->{1}{12};
  @{$s->{3}}{0,3,4,1,8,5,10,12,9} = @{$t->{0}}{0,2..4,7,8,9,11,12};
  @{$s->{4}}{0,1..3,6,7,10..12} = @{$t->{3}}{0,3,4,1,8,5,12,9,10};
  $s->{5}{9} = $t->{2}{12};
}
sub rotR {
	my $t = tmpcpy;
	@{$s->{0}}{0,3,4,1,8,5,12,9,10} = @{$t->{1}}{0,2..4,7,8,11,12,9};
	@{$s->{1}}{0,2..4,7,8,11,12,9} = @{$t->{4}}{0,4,1,2,5,6,9..11};
	$s->{2}{9} = $t->{5}{12};
	$s->{3}{9} = $t->{2}{9};
  @{$s->{4}}{0,4,1,2,5,6,9..11} = @{$t->{0}}{0,3,4,1,8,5,12,9,10};
  $s->{5}{12} = $t->{3}{9};
}
sub rotS {
	my $t = tmpcpy;
	@{$s->{0}}{0,4,1,2,5,6,9..11} = @{$t->{2}}{0,3,4,1,8,5,12,9,10};
	@{$s->{1}}{0..3,6,7,10..12} = @{$t->{0}}{0,4,1,2,5,6,9..11};
  @{$s->{2}}{0,3,4,1,8,5,12,9,10} = @{$t->{1}}{0..3,6,7,10..12};
	$s->{3}{10} = $t->{5}{11};
	$s->{4}{10} = $t->{3}{10};
  $s->{5}{11} = $t->{4}{10};
}
sub rotT {
	my $t = tmpcpy;
	$s->{0}{10} = $t->{3}{11};
	@{$s->{1}}{0,4,1,2,5,6,9..11} = @{$t->{2}}{0,4,1,2,5,6,9..11};
  @{$s->{2}}{0,4,1,2,5,6,9..11} = @{$t->{5}}{0..3,6,7,10..12};
	$s->{3}{11} = $t->{4}{9};
  $s->{4}{9} = $t->{0}{10};
	@{$s->{5}}{0..3,6,7,10..12} = @{$t->{1}}{0,4,1,2,5,6,9..11};
}
sub rotU {
	my $t = tmpcpy;
	$s->{0}{9} = $t->{2}{10};
	@{$s->{1}}{0,3,4,1,8,5,12,9,10} = @{$t->{5}}{0,2..4,7,8,11,12,9};
	$s->{2}{10} = $t->{3}{12};
  $s->{3}{12} = $t->{0}{9};
  @{$s->{4}}{0,3,4,1,8,5,12,9,10} = @{$t->{1}}{0,3,4,1,8,5,12,9,10};
	@{$s->{5}}{0,2..4,7,8,11,12,9} = @{$t->{4}}{0,3,4,1,8,5,12,9,10};
}
sub rotV {
	my $t = tmpcpy;
	$s->{0}{12} = $t->{1}{9};
	$s->{1}{9} = $t->{2}{11};
  $s->{2}{11} = $t->{0}{12};
	@{$s->{3}}{0,2..4,7,8,11,12,9} = @{$t->{4}}{0,2..4,7,8,11,12,9};
  @{$s->{4}}{0,2..4,7,8,11,12,9} = @{$t->{5}}{0,3,4,1,8,5,12,9,10};
	@{$s->{5}}{0,3,4,1,8,5,12,9,10} = @{$t->{3}}{0,2..4,7,8,11,12,9};
}
sub rotW {
	my $t = tmpcpy;
	$s->{0}{11} = $t->{4}{12};
	$s->{1}{10} = $t->{0}{11};
	@{$s->{2}}{0..3,6,7,10..12} = @{$t->{3}}{0..3,6,7,10..12};
  @{$s->{3}}{0..3,6,7,10..12} = @{$t->{5}}{0,4,1,2,5,6,9..11};
  $s->{4}{12} = $t->{1}{10};
	@{$s->{5}}{0,4,1,2,5,6,9..11} = @{$t->{2}}{0..3,6,7,10..12};
}
sub rotp {
	my $t = tmpcpy;
	@{$s->{0}}{0..3,6,7,10..12} = @{$t->{2}}{0,2..4,7,8,11,12,9};
	$s->{1}{11} = $t->{5}{10};
	@{$s->{2}}{0,2..4,7,8,9,11,12} = @{$t->{3}}{0,4,1,2,5,6,11,9,10};
	@{$s->{3}}{0,4,1,2,5,6,9..11} = @{$t->{0}}{0..3,6,7,10..12};
	$s->{4}{11} = $t->{1}{11};
	$s->{5}{10} = $t->{4}{11};
}
sub rotq {
	my $t = tmpcpy;
	@{$s->{0}}{0,2..4,7,8,9,11,12} = @{$t->{3}}{0,3,4,1,8,5,10,12,9};
	$s->{1}{12} = $t->{2}{12};
	$s->{2}{12} = $t->{5}{9};
	@{$s->{3}}{0,3,4,1,8,5,12,9,10} = @{$t->{4}}{0,1..3,6,7,10..12};
	@{$s->{4}}{0..3,6,7,10..12} = @{$t->{0}}{0,2..4,7,8,11,12,9};
	$s->{5}{9} = $t->{1}{12};
}
sub rotr {
	my $t = tmpcpy;
	@{$s->{0}}{0,3,4,1,8,5,12,9,10} = @{$t->{4}}{0,4,1,2,5,6,9..11};
	@{$s->{1}}{0,2..4,7,8,11,12,9} = @{$t->{0}}{0,3,4,1,8,5,12,9,10};
	$s->{2}{9} = $t->{3}{9};
	$s->{3}{9} = $t->{5}{12};
	@{$s->{4}}{0,4,1,2,5,6,9..11} = @{$t->{1}}{0,2..4,7,8,11,12,9};
	$s->{5}{12} = $t->{2}{9};
}
sub rots {
	my $t = tmpcpy;
	@{$s->{0}}{0,4,1,2,5,6,9..11} = @{$t->{1}}{0..3,6,7,10..12};
	@{$s->{1}}{0..3,6,7,10..12} = @{$t->{2}}{0,3,4,1,8,5,12,9,10};
	@{$s->{2}}{0,3,4,1,8,5,12,9,10} = @{$t->{0}}{0,4,1,2,5,6,9..11};
	$s->{3}{10} = $t->{4}{10};
	$s->{4}{10} = $t->{5}{11};
	$s->{5}{11} = $t->{3}{10};
}
sub rott {
	my $t = tmpcpy;
	$s->{0}{10} = $t->{4}{9};
	@{$s->{1}}{0,4,1,2,5,6,9..11} = @{$t->{5}}{0..3,6,7,10..12};
	@{$s->{2}}{0,4,1,2,5,6,9..11} = @{$t->{1}}{0,4,1,2,5,6,9..11};
	$s->{3}{11} = $t->{0}{10};
	$s->{4}{9} = $t->{3}{11};
	@{$s->{5}}{0..3,6,7,10..12} = @{$t->{2}}{0,4,1,2,5,6,9..11};
}
sub rotu {
	my $t = tmpcpy;
	$s->{0}{9} = $t->{3}{12};
	@{$s->{1}}{0,3,4,1,8,5,12,9,10} = @{$t->{4}}{0,3,4,1,8,5,12,9,10};
	$s->{2}{10} = $t->{0}{9};
	$s->{3}{12} = $t->{2}{10};
	@{$s->{4}}{0,3,4,1,8,5,12,9,10} = @{$t->{5}}{0,2..4,7,8,11,12,9};
	@{$s->{5}}{0,2..4,7,8,11,12,9} = @{$t->{1}}{0,3,4,1,8,5,12,9,10};
}
sub rotv {
	my $t = tmpcpy;
	$s->{0}{12} = $t->{2}{11};
	$s->{1}{9} = $t->{0}{12};
	$s->{2}{11} = $t->{1}{9};
	@{$s->{3}}{0,2..4,7,8,11,12,9} = @{$t->{5}}{0,3,4,1,8,5,12,9,10};
	@{$s->{4}}{0,2..4,7,8,11,12,9} = @{$t->{3}}{0,2..4,7,8,11,12,9};
	@{$s->{5}}{0,3,4,1,8,5,12,9,10} = @{$t->{4}}{0,2..4,7,8,11,12,9};
}
sub rotw {
	my $t = tmpcpy;
	$s->{0}{11} = $t->{1}{10};
	$s->{1}{10} = $t->{4}{12};
	@{$s->{2}}{0..3,6,7,10..12} = @{$t->{5}}{0,4,1,2,5,6,9..11};
	@{$s->{3}}{0..3,6,7,10..12} = @{$t->{2}}{0..3,6,7,10..12};
	$s->{4}{12} = $t->{0}{11};
	@{$s->{5}}{0,4,1,2,5,6,9..11} = @{$t->{3}}{0..3,6,7,10..12};
}
sub run {
	my $cmd = shift @ARGV;
	die "Only valid: PQRSTUVWpqrstuvw\n" unless $cmd =~ /^[p-w]+$/i;
	my @a = split//, $cmd;
	eval "rot$_" while $_ = shift @a;
	say $cmd;
	rep6;
}

1;
